home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-pc.el.z / efs-pc.el
Encoding:
Text File  |  1998-05-21  |  33.8 KB  |  981 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-pc.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  PC support for efs
  9. ;; Author:       Sandy Rutherford <sandy@tsmi19.sissa.it>
  10. ;; Created:      Thu Mar 18 13:06:25 1993
  11. ;; Modified:     Sun Nov 27 18:40:46 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. ;;; Thanks to jrs@world.std.com (Rick Sladkey) for providing support for
  20. ;;; the Frontier Technologies Super-TCP server
  21.  
  22. ;;; Many thanks to the following people for beta testing:
  23. ;;;      Mike Northam <mbn@hfglobe.intel.com>
  24. ;;;      bagman@austin.ibm.com (Doug Bagley)
  25. ;;;      Jens Petersen <J.Petersen@qmw.ac.uk>
  26. ;;;      Jeff Morgenthaler <jpmorgen@wisp4.physics.wisc.edu>
  27.  
  28. (provide 'efs-pc)
  29. (require 'efs)
  30.  
  31. (defconst efs-pc-version
  32.   (concat (substring "$efs release: 1.15 $" 14 -2)
  33.       "/"
  34.       (substring "#Revision: 1.1 $" 11 -2)))
  35.  
  36. ;;;-----------------------------------------------------------------
  37. ;;; PC support for efs
  38. ;;;-----------------------------------------------------------------
  39.  
  40. ;;; Works for the DOS FTP servers:
  41. ;;; Novell LAN WorkPlace v4.01 (NetWare & EXOS)
  42. ;;; PC/TCP Version 2.05 pl2 FTP Server by FTP Software
  43. ;;; Microsoft FTP Server service (beta 2)
  44. ;;; NCSA DOS ftp server.
  45. ;;; Frontier Technologies super tcp server (runs under MS WINDOWS)
  46. ;;; Alun's Windows FTP daemon for Winsock, v1.8b
  47. ;;;
  48. ;;; Works for IBM OS/2 TCP/IP FTP Version 1.2
  49.  
  50. ;;; Currently support for all of the above FTP servers are in this file.
  51. ;;; Should they live in separate files?
  52.  
  53. ;;; host and listing type hierarchy in this file
  54. ;;;
  55. ;;; dos: dos:novell, dos:ftp, dos:ncsa, dos:microsoft, dos:stcp, dos:winsock
  56. ;;; os2:
  57.  
  58. ;;; DOS and OS/2 have slightly different filename syntaxes.
  59. ;;;
  60. ;;; DOS only allows at most one extension (".") per filename.
  61. ;;; A directory name usually has the extension ".DIR" implicit, but
  62. ;;; it seems that other extensions can be used.
  63. ;;;
  64. ;;; OS/2 running the FAT file system uses the same 8.3 format for
  65. ;;; filenames as DOS, except that extensions are allowed in directory names.
  66. ;;; OS/2 running the HPFS (high performance file system allows an arbitrary
  67. ;;; number of extensions in a filename.
  68. ;;; Mostly these differences are unimportant here, except in the dos
  69. ;;; definition of efs-allow-child-lookup.
  70.  
  71. ;;;; ----------------------------------------------------
  72. ;;;; Utility functions and macros
  73. ;;;; ----------------------------------------------------
  74.  
  75. (defun efs-fix-pc-path (path &optional reverse)
  76.   ;; Convert PATH from UNIX-ish to DOS or OS/2.
  77.   ;; If REVERSE do just that.
  78.   (efs-save-match-data
  79.     (if reverse
  80.     (let ((n 0)
  81.           len res)
  82.       (if (string-match "^[a-zA-Z0-9]:" path)
  83.           ;; there's a disk
  84.         (setq res (concat "\\" path))
  85.         (setq res (copy-sequence path)))
  86.       (setq len (length res))
  87.       (while (< n len)
  88.         (and (= (aref res n) ?\\ ) (aset res n ?/))
  89.         (setq n (1+ n)))
  90.       res)
  91.       (let ((n 0)
  92.         len res)
  93.     (if (string-match "^/[a-zA-Z0-9]:" path)
  94.         (setq res (substring path 1))
  95.       (setq res (copy-sequence path)))
  96.     (setq len (length res))
  97.     (while (< n len)
  98.       (and (= (aref res n) ?/) (aset res n ?\\ ))
  99.       (setq n (1+ n)))
  100.     res))))
  101.  
  102. (defmacro efs-dired-pc-move-to-end-of-filename (&optional no-error bol eol)
  103.   ;; Assumes point is at the beginning of filename.
  104.   ;; So, it should be called only after (dired-move-to-filename t)
  105.   ;; On failure signals an error, or returns nil.
  106.   ;; This is the DOS and OS/2 version. It is common to all of the PC ftp
  107.   ;; servers since it depends only on the file name character set.
  108.   (`
  109.    (let ((opoint (point)))
  110.      (and selective-display
  111.       (null (, no-error))
  112.       (eq (char-after
  113.            (1- (or (, bol) (save-excursion
  114.                  (skip-chars-backward "^\r\n")
  115.                  (point)))))
  116.           ?\r)
  117.       ;; File is hidden or omitted.
  118.       (cond
  119.        ((dired-subdir-hidden-p (dired-current-directory))
  120.         (error
  121.          (substitute-command-keys
  122.           "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  123.        ((error
  124.          (substitute-command-keys
  125.           "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  126.           )))))
  127.      (skip-chars-forward "-_+=a-zA-Z0-9.$~")
  128.      (if (= opoint (point))
  129.      (if (, no-error)
  130.          nil
  131.        (error "No file on this line"))
  132.        (point)))))
  133.  
  134. (defun efs-dired-pc-insert-headerline (dir)
  135.   ;; Insert a blank line for aesthetics.
  136.   (insert " \n")
  137.   (forward-char -2)
  138.   (efs-real-dired-insert-headerline dir))
  139.  
  140.  
  141. ;;;;-----------------------------------------------------------
  142. ;;;; General DOS support
  143. ;;;;-----------------------------------------------------------
  144.  
  145. ;;; Regexps to be used for host and listing-type identification.
  146.  
  147. (defconst efs-dos:ftp-file-line-regexp
  148.   (concat
  149.    " *\\([0-9]+\\|<dir>\\) +\\([-_+=a-zA-Z0-9$~.]+\\)"
  150.    " +\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\) "
  151.    "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|"
  152.    "Oct\\|Nov\\|Dec\\) [0-3][0-9] "))
  153.  
  154. (defconst efs-dos:microsoft-file-line-regexp
  155.   ;; matches all the way to the first char of the filename.
  156.   (concat
  157.    "[01][0-9]-[0-3][0-9]-[0-9][0-9] +[012][0-9]:[0-5][0-9][AP]M +"
  158.    "\\(<DIR>\\|[0-9]+\\) +"))
  159.  
  160. (defconst efs-dos:ncsa-file-line-regexp
  161.   "\\([-_+=a-zA-Z0-9$.~]+\\) +\\(<DIR>\\|[0-9]+\\)[ \n]")
  162.  
  163. (defconst efs-dos:stcp-file-line-regexp
  164.   (concat
  165.    "\\([-_+=a-zA-Z0-9$~.]+\\) +\\(<DIR>\\|[0-9]+\\) "
  166.    "+[0-9][0-9]?-[0-3][0-9]-[12][90][0-9][0-9] +"
  167.    "[0-9][0-9]?:[0-5][0-9]"))
  168.  
  169. (defconst efs-dos:winsock-date-and-size-regexp
  170.   (concat
  171.    " \\([0-9]+\\) "
  172.    "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|"
  173.    "Dec\\) [ 0-3][0-9] \\( [12][0-9][0-9][0-9]\\|[0-2][0-9]:[0-6][0-9]\\) +"))
  174.  
  175. (efs-defun efs-parse-listing dos
  176.   (host user dir path &optional switches)
  177.   ;; Examine the listing, which is assumed to be either a DOS or OS/2
  178.   ;; listing, and determine the operating system type and FTP server.
  179.   ;; HOST = remote host name
  180.   ;; USER = remote user name
  181.   ;; DIR = directory as a full remote path
  182.   ;; PATH = directory in full efs-path syntax
  183.   ;; No need to check for OS/2, as it gets ID'ed by a SYST in
  184.   ;; efs-guess-host-type.
  185.   (efs-save-match-data
  186.     (cond
  187.  
  188.      ;; Check for the Microsoft server
  189.      ((re-search-forward efs-dos:microsoft-file-line-regexp nil t)
  190.       (efs-add-listing-type 'dos:microsoft host user)
  191.       (efs-parse-listing 'dos:microsoft host user dir path switches))
  192.      
  193.      ;; Check for the Novell FTP server
  194.      ((save-excursion
  195.     (goto-char (point-max))
  196.     (forward-line -1)
  197.     (looking-at " [0-9]+ File(s)\n"))
  198.       (efs-add-listing-type 'dos:novell host user)
  199.       (efs-parse-listing 'dos:novell host user dir path switches))
  200.  
  201.      ;; Check for FTP software's server
  202.      ((re-search-forward efs-dos:ftp-file-line-regexp nil t)
  203.       (efs-add-listing-type 'dos:ftp host user)
  204.       (efs-parse-listing 'dos:ftp host user dir path switches))
  205.  
  206.      ;; Check for winsock
  207.      ((re-search-forward efs-dos:winsock-date-and-size-regexp nil t)
  208.       (efs-add-listing-type 'dos:winsock host user)
  209.       (efs-parse-listing 'dos:winsock host user dir path switches))
  210.      
  211.      ;; Check for the NCSA FTP server
  212.      ((re-search-forward efs-dos:ncsa-file-line-regexp nil t)
  213.       (efs-add-listing-type 'dos:ncsa host user)
  214.       (efs-parse-listing 'dos:ncsa host user dir path switches))
  215.  
  216.      ;; Check for Frontier's Super-TCP server
  217.      ((re-search-forward efs-dos:stcp-file-line-regexp nil t)
  218.       (efs-add-listing-type 'dos:stcp host user)
  219.       (efs-parse-listing 'dos:stcp host user dir path switches))
  220.      
  221.      ((string-match "^/\\([A-Za-z0-9]:/\\)?$" dir)
  222.       ;; root always exists
  223.       (let ((tbl (efs-make-hashtable)))
  224.     (efs-put-hash-entry "." '(t) tbl)
  225.     (efs-put-hash-entry ".." '(t) tbl)
  226.     tbl))
  227.      (t
  228.       ;; an error message?
  229.       nil))))
  230.  
  231. ;; Some DOS servers (NCSA), return a 501 message for an empty disk.
  232. (efs-defun efs-ls-dumb-check dos (line host file path lsargs msg noparse
  233.                        noerror nowait cont)
  234.   (and (string-match "^501 " line)
  235.        (string-match "^/[A-Za-z0-9]:/?$" path)
  236.        (let ((parse (or (null noparse) (eq noparse 'parse)
  237.             (efs-parsable-switches-p lsargs t))))
  238.      (efs-add-to-ls-cache file lsargs "\n" parse)
  239.      (if parse
  240.          (efs-set-files file (let ((tbl (efs-make-hashtable)))
  241.                    (efs-put-hash-entry "." '(t) tbl)
  242.                    (efs-put-hash-entry ".." '(t) tbl)
  243.                    tbl)))
  244.      (if nowait
  245.          (progn
  246.            (if cont
  247.            (efs-call-cont cont "\n"))
  248.            t)
  249.        (if cont
  250.            (efs-call-cont cont "\n"))
  251.        "\n"))))
  252.  
  253. (efs-defun efs-fix-path dos (path &optional reverse)
  254.   (efs-fix-pc-path path reverse))
  255.  
  256. (efs-defun efs-fix-dir-path dos (dir-path)
  257.   ;; Convert path from UNIX-ish to DOS for a DIRectory listing.
  258.   (cond ((string-match "^/\\(.:\\)?$" dir-path)
  259.      (error "Can't list DOS or OS/2 disks"))
  260.     ;; Neither DOS nor OS/2 allows us to end the name of a directory
  261.     ;; with an "\".
  262.     ;; Adding *.* to the end also allows us to distinguish plain files from
  263.     ;; directories.  All DOS servers seem to understand this except
  264.     ;; Frontier Technologies' super-tcp server.
  265.     ((string-match "/$" dir-path)
  266.      (concat (efs-fix-pc-path dir-path) "*.*"))
  267.     (t (efs-fix-pc-path dir-path))))
  268.  
  269. (efs-defun efs-get-pwd dos (host user &optional xpwd)
  270.   ;; Parses PWD output for the current working directory. Hopefully this is
  271.   ;; DOS proof.
  272.   (let* ((result (efs-send-cmd host user (list 'quote
  273.                             (if xpwd 'xpwd 'pwd))
  274.                     "Getting PWD"))
  275.      (line (nth 1 result))
  276.      dir)
  277.     (if (car result)
  278.     (efs-save-match-data
  279.       (and (or (string-match "\"\\([^\"]*\\)\"" line)
  280.            ;; FTP software's output. They should know better...
  281.            (string-match "Current working directory is +\\([^ ]+\\)$"
  282.                  line))
  283.            (setq dir (substring line
  284.                     (match-beginning 1)
  285.                     (match-end 1))))))
  286.     (cons dir line)))
  287.  
  288. (efs-defun efs-allow-child-lookup dos (host user dir file)
  289.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  290.   ;; according to its file-name syntax, and therefore a child listing should
  291.   ;; be attempted.
  292.  
  293.   ;; Subdirs in DOS usually don't have an extension.
  294.   (not (string-match "\\." file)))
  295.  
  296. ;;;;-----------------------------------
  297. ;;;; Support for the Novell FTP server
  298. ;;;;-----------------------------------
  299.  
  300. (defconst efs-dos:novell-file-line-regexp
  301.   ;; Matches from the first character of the filename to the end of the date.
  302.   ;; Does not match parent directories which the server might decide
  303.   ;; to put in front of the filename.
  304.   (concat
  305.    "\\([-_+=a-zA-Z0-9$.~]+\\) +\\(<DIR>\\|[0-9]+\\) +"
  306.    "[ 0-9][0-9]-[0-9][0-9]-[0-9][0-9] "))
  307.  
  308. (efs-defun efs-parse-listing dos:novell
  309.   (host user dir path &optional switches)
  310.   ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
  311.   ;; HOST = remote host name
  312.   ;; USER = remote user name
  313.   ;; DIR = directory as a full remote path
  314.   ;; PATH = directory in full efs-path syntax
  315.   (let ((tbl (efs-make-hashtable))
  316.     file size dir-p)
  317.     (efs-save-match-data
  318.       ;; Can we check somehow if the listing is really for something
  319.       ;; that doesn't exist?
  320.       (goto-char (point-min))
  321.       (while (re-search-forward efs-dos:novell-file-line-regexp
  322.                 nil t)
  323.     (setq file (buffer-substring (match-beginning 1)
  324.                      (match-end 1))
  325.           size (buffer-substring (match-beginning 2)
  326.                      (match-end 2)))
  327.     (if (string-equal size "<DIR>")
  328.         (setq size nil
  329.           dir-p t)
  330.       (setq size (string-to-int size)
  331.         dir-p nil))
  332.     (efs-put-hash-entry file (list dir-p size) tbl)
  333.     (forward-line 1))
  334.       (efs-put-hash-entry "." '(t) tbl)
  335.       (efs-put-hash-entry ".." '(t) tbl)
  336.       tbl)))
  337.  
  338. ;;; Tree Dired Support
  339.  
  340. (defconst efs-dired-dos:novell-re-exe
  341.   "^. [ \t]+[-_+=a-zA-Z0-9$~]+\\.exe ")
  342.  
  343. (or (assq 'dos:novell efs-dired-re-exe-alist)
  344.     (setq efs-dired-re-exe-alist
  345.       (cons (cons 'dos:novell  efs-dired-dos:novell-re-exe)
  346.         efs-dired-re-exe-alist)))
  347.  
  348. (defconst efs-dired-dos:novell-re-dir
  349.   "^. [ \t]+[-_+=a-zA-Z0-9$~]+ +<DIR>")
  350.  
  351. (or (assq 'dos:novell efs-dired-re-dir-alist)
  352.     (setq efs-dired-re-dir-alist
  353.       (cons (cons 'dos:novell  efs-dired-dos:novell-re-dir)
  354.         efs-dired-re-dir-alist)))
  355.  
  356. (efs-defun efs-dired-insert-headerline dos:novell (dir)
  357.   (efs-dired-pc-insert-headerline dir))
  358.  
  359. (efs-defun efs-dired-manual-move-to-filename dos:novell
  360.   (&optional raise-error bol eol)
  361.   ;; In dired, move to the first char of filename on this line.
  362.   ;; Returns (point) or nil if raise-error is nil, and there is no
  363.   ;; no filename on this line.
  364.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  365.   (let (case-fold-search)
  366.     (if bol
  367.     (goto-char bol)
  368.       (skip-chars-backward "^\n\r"))
  369.     ;; move over marker
  370.     (if (re-search-forward efs-dos:novell-file-line-regexp eol t)
  371.     (goto-char (match-beginning 0)) ; returns (point)
  372.       (and raise-error (error "No file on this line")))))
  373.     
  374. (efs-defun efs-dired-manual-move-to-end-of-filename dos:novell
  375.   (&optional no-error bol eol)
  376.   ;; Assumes point is at the beginning of filename.
  377.   ;; So, it should be called only after (dired-move-to-filename t)
  378.   ;; On failure signals an error, or returns nil.
  379.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  380.  
  381. (efs-defun efs-dired-fixup-listing dos:novell
  382.   (file path &optional switches wildcard)
  383.   ;; DOS may insert the entire directory name in front of the file name.
  384.   ;; Scrape it off. The Novell server seems to do weird things when insert
  385.   ;; the full-path, so be liberal with the hatchet.
  386.   (goto-char (point-min))
  387.   (while (re-search-forward efs-dos:novell-file-line-regexp nil t)
  388.     (beginning-of-line)
  389.     (delete-region (point) (match-beginning 0))
  390.     (forward-line 1))
  391.   ;; the novell server outputs lines in seemingly random order
  392.   ;; this isn't as good as sorting switches, but at least it's not random.
  393.   (sort-fields 1 (point-min) (progn (goto-char (point-max))
  394.                     (forward-line -1)
  395.                     (point))))
  396.  
  397. (efs-defun efs-dired-ls-trim dos:novell ()
  398.   (goto-char (point-min))
  399.   (let (case-fold-search)
  400.     (forward-line 1)
  401.     (if (looking-at " [0-9]+ File(s)\n")
  402.     (delete-region (match-beginning 0) (match-end 0)))))
  403.  
  404.  
  405. ;;;;-----------------------------------------------
  406. ;;;; PC/TCP (by FTP software) support
  407. ;;;;-----------------------------------------------
  408.  
  409. (efs-defun efs-parse-listing dos:ftp
  410.   (host user dir path &optional switches)
  411.   ;; Parse the current buffer which is assumed to be an FTP Software DOS
  412.   ;; listing.
  413.   ;; HOST = remote host name
  414.   ;; USER = remote user name
  415.   ;; DIR = directory as a full remote path
  416.   ;; PATH = directory in full efs-path syntax
  417.   (let ((tbl (efs-make-hashtable))
  418.     file size dir-p)
  419.     (efs-save-match-data
  420.       ;; Can we check somehow if an empty directory is really
  421.       ;; a nonexistent directory?
  422.       (goto-char (point-min))
  423.       (goto-char (point-min))
  424.       (while (looking-at efs-dos:ftp-file-line-regexp)
  425.     (setq file (buffer-substring (match-beginning 2)
  426.                      (match-end 2))
  427.           size (buffer-substring (match-beginning 1)
  428.                      (match-end 1)))
  429.     (if (string-equal size "<dir>")
  430.         (setq size nil
  431.           dir-p t)
  432.       (setq size (string-to-int size)
  433.         dir-p nil))
  434.     (efs-put-hash-entry file (list dir-p size) tbl)
  435.     (forward-line 1))
  436.       (efs-put-hash-entry "." '(t) tbl)
  437.       (efs-put-hash-entry ".." '(t) tbl)
  438.       tbl)))
  439.  
  440. ;;; Tree Dired Support
  441.  
  442. (defconst efs-dired-dos:ftp-re-exe
  443.   "^. [ \t]*[0-9]+ +[-_+=a-zA-Z0-9$~]+\\.exe ")
  444.  
  445. (or (assq 'dos:ftp efs-dired-re-exe-alist)
  446.     (setq efs-dired-re-exe-alist
  447.       (cons (cons 'dos:ftp  efs-dired-dos:ftp-re-exe)
  448.         efs-dired-re-exe-alist)))
  449.  
  450. (defconst efs-dired-dos:ftp-re-dir
  451.   "^. [ \t]*<dir> ")
  452.  
  453. (or (assq 'dos:ftp efs-dired-re-dir-alist)
  454.     (setq efs-dired-re-dir-alist
  455.       (cons (cons 'dos:ftp  efs-dired-dos:ftp-re-dir)
  456.         efs-dired-re-dir-alist)))
  457.  
  458. (efs-defun efs-dired-insert-headerline dos:ftp (dir)
  459.   (efs-dired-pc-insert-headerline dir))
  460.  
  461. ;;; Because dos:ftp listings have the file names right justified,
  462. ;;; I have reversed what -move-to-filename and -move-to-end-of-filename
  463. ;;; actually do. This shouldn't confuse dired, and should make browsing
  464. ;;; a dos:ftp listing more aesthetically pleasing.
  465.  
  466. (efs-defun efs-dired-manual-move-to-filename dos:ftp
  467.   (&optional raise-error bol eol)
  468.   ;; In dired, move to the *last* char of filename on this line.
  469.   ;; Returns (point) or nil if raise-error is nil, and there is no
  470.   ;; no filename on this line.
  471.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  472.   (let (case-fold-search)
  473.     (if bol
  474.     (goto-char bol)
  475.       (skip-chars-backward "^\n\r"))
  476.     (if (re-search-forward efs-dos:ftp-file-line-regexp eol t)
  477.     (goto-char (match-end 2)) ; returns (point)
  478.       (and raise-error (error "No file on this line")))))
  479.  
  480. (efs-defun efs-dired-manual-move-to-end-of-filename dos:ftp
  481.   (&optional no-error bol eol)
  482.   ;; Assumes point is at the *end* of filename. Really moves the
  483.   ;; point to the beginning of the filename.
  484.   ;; So, it should be called only after (dired-move-to-filename t)
  485.   ;; On failure signals an error, or returns nil.
  486.   ;; This is the DOS version. It is common to all of the DOS ftp servers
  487.   ;; since it depends only on the file name character set.
  488.   (let ((opoint (point)))
  489.     (and selective-display
  490.      (null no-error) 
  491.      (eq (char-after
  492.           (1- (or bol (save-excursion
  493.                 (skip-chars-backward "^\r\n")
  494.                 (point)))))
  495.          ?\r)
  496.      ;; File is hidden or omitted.
  497.      (cond
  498.       ((dired-subdir-hidden-p (dired-current-directory))
  499.        (error
  500.         (substitute-command-keys
  501.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  502.       ((error
  503.         (substitute-command-keys
  504.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  505.          )))))
  506.     (skip-chars-backward "-_+=a-zA-Z0-9.$~" bol)
  507.     (if (= opoint (point))
  508.     (if no-error
  509.         nil
  510.       (error "No file on this line"))
  511.       (point))))
  512.  
  513. ;;;;-----------------------------------------------
  514. ;;;; NCSA FTP support
  515. ;;;;-----------------------------------------------
  516.  
  517. (efs-defun efs-parse-listing dos:ncsa
  518.   (host user dir path &optional switches)
  519.   ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
  520.   ;; HOST = remote host name
  521.   ;; USER = remote user name
  522.   ;; DIR = directory as a full remote path
  523.   ;; PATH = directory in full efs-path syntax
  524.   (let (tbl file size dir-p next)
  525.     (efs-save-match-data
  526.       (goto-char (point-min))
  527.       (while (re-search-forward
  528.           efs-dos:ncsa-file-line-regexp
  529.           (setq next (save-excursion (forward-line 1) (point))) t)
  530.     (setq file (buffer-substring (match-beginning 1)
  531.                      (match-end 1))
  532.           size (buffer-substring (match-beginning 2)
  533.                      (match-end 2)))
  534.     (if (string-equal size "<DIR>")
  535.         (setq size nil
  536.           dir-p t)
  537.       (setq size (string-to-int size)
  538.         dir-p nil))
  539.     (efs-put-hash-entry file (list dir-p size)
  540.                 (or tbl (setq tbl (efs-make-hashtable))))
  541.     (goto-char next))
  542.       ;; DOS does not put . and .. in the root directory.
  543.       (if (or tbl
  544.           ;; root always exists
  545.           (string-match "^/\\([A-Za-z0-9]:/\\)?$" dir))
  546.       (progn
  547.         (efs-put-hash-entry "." '(t) tbl)
  548.         (efs-put-hash-entry ".." '(t) tbl)))
  549.       tbl)))
  550.  
  551. ;;; Tree Dired Support
  552.  
  553. (defconst efs-dired-dos:ncsa-re-exe
  554.   "^. [ \t]+[-_+=a-zA-Z0-9$~]+\\.exe ")
  555.  
  556. (or (assq 'dos:ncsa efs-dired-re-exe-alist)
  557.     (setq efs-dired-re-exe-alist
  558.       (cons (cons 'dos:ncsa  efs-dired-dos:ncsa-re-exe)
  559.         efs-dired-re-exe-alist)))
  560.  
  561. (defconst efs-dired-dos:ncsa-re-dir
  562.   "^. [ \t]+[-_+=a-zA-Z0-9$~]+ +<DIR>")
  563.  
  564. (or (assq 'dos:ncsa efs-dired-re-dir-alist)
  565.     (setq efs-dired-re-dir-alist
  566.       (cons (cons 'dos:ncsa  efs-dired-dos:ncsa-re-dir)
  567.         efs-dired-re-dir-alist)))
  568.  
  569. (efs-defun efs-dired-insert-headerline dos:ncsa (dir)
  570.   (efs-dired-pc-insert-headerline dir))
  571.  
  572. (efs-defun efs-dired-manual-move-to-filename dos:ncsa
  573.   (&optional raise-error bol eol)
  574.   ;; In dired, move to the first char of filename on this line.
  575.   ;; Returns (point) or nil if raise-error is nil, and there is no
  576.   ;; no filename on this line.
  577.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  578.   (let (case-fold-search)
  579.     (if bol
  580.     (goto-char bol)
  581.       (skip-chars-backward "^\n\r"))
  582.     (if (re-search-forward "[-_+=a-zA-Z0-9$.~]+ +\\(<DIR>\\|[0-9]\\)" eol t)
  583.     (goto-char (match-beginning 0)) ; returns (point)
  584.       (and raise-error (error "No file on this line")))))
  585.     
  586. (efs-defun efs-dired-manual-move-to-end-of-filename dos:ncsa
  587.   (&optional no-error bol eol)
  588.   ;; Assumes point is at the beginning of filename.
  589.   ;; So, it should be called only after (dired-move-to-filename t)
  590.   ;; On failure signals an error, or returns nil.
  591.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  592.  
  593. (efs-defun efs-dired-fixup-listing dos:ncsa
  594.   (file path &optional switches wildcard)
  595.   ;; DOS may insert the entire directory name in front of the file name.
  596.   ;; Scrape it off.
  597.   (let (bonl)
  598.     (goto-char (point-min))
  599.     (while (re-search-forward
  600.         efs-dos:ncsa-file-line-regexp
  601.         (setq bonl (save-excursion (forward-line 1) (point))) t)
  602.       (goto-char (match-beginning 0))
  603.       (delete-region (point) (progn (beginning-of-line) (point)))
  604.       (goto-char bonl)))
  605.   ;; sort the buffer
  606.   (sort-fields 1 (point-min) (point-max)))
  607.  
  608. (efs-defun efs-dired-ls-trim dos:ncsa ()
  609.   (goto-char (point-min))
  610.   (if (re-search-forward efs-dos:ncsa-file-line-regexp nil t)
  611.       (delete-region (point-min) (match-beginning 0))))
  612.  
  613. ;;;;-----------------------------------------------
  614. ;;;; Microsoft DOS FTP support
  615. ;;;;-----------------------------------------------
  616.  
  617. (defconst efs-dos:microsoft-valid-listing-regexp
  618.   (concat efs-dos:microsoft-file-line-regexp "\\."))
  619.   
  620. (efs-defun efs-parse-listing dos:microsoft
  621.   (host user dir path &optional switches)
  622.   ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
  623.   ;; HOST = remote host name
  624.   ;; USER = remote user name
  625.   ;; DIR = directory as a full remote path
  626.   ;; PATH = directory in full efs-path syntax
  627.  
  628.   ;; Use the existence of a "." file as confirmation that it's really
  629.   ;; a directory listing.
  630.   (goto-char (point-min))
  631.   (efs-save-match-data
  632.     (if (or (string-match "^/.:/$" dir)
  633.         (re-search-forward efs-dos:microsoft-valid-listing-regexp nil t))
  634.     (let ((tbl (efs-make-hashtable))
  635.           size dir-p)
  636.       (goto-char (point-min))
  637.       (while (re-search-forward efs-dos:microsoft-file-line-regexp nil t)
  638.         (setq size (buffer-substring (match-beginning 1) (match-end 1)))
  639.         (if (string-equal size "<DIR>")
  640.         (setq size nil
  641.               dir-p t)
  642.           (setq size (string-to-int size)
  643.             dir-p nil))
  644.         (efs-put-hash-entry (buffer-substring (point)
  645.                           (progn (end-of-line)
  646.                              (point)))
  647.                 (list dir-p size) tbl)
  648.         (forward-line 1))
  649.       (efs-put-hash-entry "." '(t) tbl)
  650.       (efs-put-hash-entry ".." '(t) tbl)
  651.       tbl))))
  652.  
  653. ;;; Tree Dired Support
  654.  
  655. (defconst efs-dired-dos:microsoft-re-exe
  656.   "^[^\n]+ +[-_+=a-zA-Z0-9$~]+\\.\\(EXE\\|exe\\)$")
  657.  
  658. (or (assq 'dos:microsoft efs-dired-re-exe-alist)
  659.     (setq efs-dired-re-exe-alist
  660.       (cons (cons 'dos:microsoft  efs-dired-dos:microsoft-re-exe)
  661.         efs-dired-re-exe-alist)))
  662.  
  663. (defconst efs-dired-dos:microsoft-re-dir
  664.   "^[^\n]+ <DIR> ")
  665.  
  666. (or (assq 'dos:microsoft efs-dired-re-dir-alist)
  667.     (setq efs-dired-re-dir-alist
  668.       (cons (cons 'dos:microsoft  efs-dired-dos:microsoft-re-dir)
  669.         efs-dired-re-dir-alist)))
  670.  
  671. (efs-defun efs-dired-insert-headerline dos:microsoft (dir)
  672.   (efs-dired-pc-insert-headerline dir))
  673.  
  674. (efs-defun efs-dired-manual-move-to-filename dos:microsoft
  675.   (&optional raise-error bol eol)
  676.   ;; In dired, move to the first char of filename on this line.
  677.   ;; Returns (point) or nil if raise-error is nil, and there is no
  678.   ;; no filename on this line.
  679.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  680.   (let (case-fold-search)
  681.     (if bol
  682.     (goto-char bol)
  683.       (skip-chars-backward "^\n\r"))
  684.     (if (re-search-forward efs-dos:microsoft-file-line-regexp eol t)
  685.     (goto-char (match-end 0)) ; returns (point)
  686.       (and raise-error (error "No file on this line")))))
  687.     
  688. (efs-defun efs-dired-manual-move-to-end-of-filename dos:microsoft
  689.   (&optional no-error bol eol)
  690.   ;; Assumes point is at the beginning of filename.
  691.   ;; So, it should be called only after (dired-move-to-filename t)
  692.   ;; On failure signals an error, or returns nil.
  693.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  694.  
  695. ;;;;-----------------------------------------------
  696. ;;;; Frontier's Super-TCP FTP Server for Windows
  697. ;;;;-----------------------------------------------
  698.  
  699. (efs-defun efs-parse-listing dos:stcp
  700.   (host user dir path &optional switches)
  701.   ;; Parse the current buffer which is assumed to be a Super-TCP FTP listing.
  702.   ;; HOST = remote host name
  703.   ;; USER = remote user name
  704.   ;; DIR = directory as a full remote path
  705.   ;; PATH = directory in full efs-path syntax
  706.   
  707.   ;; Use the existence of a strict file line pattern as
  708.   ;; confirmation that it's really a directory listing.
  709.   (goto-char (point-min))
  710.   (efs-save-match-data
  711.     (let ((regexp (concat "^" efs-dos:stcp-file-line-regexp)))
  712.       (if (let ((eol (save-excursion (end-of-line) (point))))
  713.         (re-search-forward regexp eol t))
  714.       (let ((tbl (efs-make-hashtable))
  715.         size dir-p)
  716.         (goto-char (point-min))
  717.         (while (re-search-forward regexp nil t)
  718.           (setq size (buffer-substring (match-beginning 2) (match-end 2)))
  719.           (if (string-equal size "<DIR>")
  720.           (setq size nil
  721.             dir-p t)
  722.         (setq size (string-to-int size)
  723.               dir-p nil))
  724.           (efs-put-hash-entry (buffer-substring (match-beginning 1)
  725.                             (match-end 1))
  726.                   (list dir-p size) tbl)
  727.           (forward-line 1))
  728.         (efs-put-hash-entry "." '(t) tbl)
  729.         (efs-put-hash-entry ".." '(t) tbl)
  730.         tbl)))))
  731.  
  732. ;;; Tree Dired Support
  733.  
  734. (defconst efs-dired-dos:stcp-re-exe
  735.   "^[-_+=a-zA-Z0-9$~]+\\.\\(EXE\\|exe\\) ")
  736.  
  737. (or (assq 'dos:stcp efs-dired-re-exe-alist)
  738.     (setq efs-dired-re-exe-alist
  739.       (cons (cons 'dos:stcp  efs-dired-dos:stcp-re-exe)
  740.          efs-dired-re-exe-alist)))
  741.  
  742. (defconst efs-dired-dos:stcp-re-dir
  743.   "^[^\n ]+ +<DIR> ")
  744.  
  745. (or (assq 'dos:stcp efs-dired-re-dir-alist)
  746.     (setq efs-dired-re-dir-alist
  747.        (cons (cons 'dos:stcp  efs-dired-dos:stcp-re-dir)
  748.          efs-dired-re-dir-alist)))
  749.  
  750. (efs-defun efs-dired-insert-headerline dos:stcp (dir)
  751.   (efs-dired-pc-insert-headerline dir))
  752.  
  753. (efs-defun efs-dired-manual-move-to-filename dos:stcp
  754.   (&optional raise-error bol eol)
  755.    ;; In dired, move to the first char of filename on this line.
  756.    ;; Returns (point) or nil if raise-error is nil, and there is no
  757.    ;; no filename on this line.
  758.    (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  759.    (let (case-fold-search)
  760.      (if bol
  761.      (goto-char bol)
  762.        (skip-chars-backward "^\n\r")
  763.        (setq bol (point)))
  764.      (if (re-search-forward efs-dos:stcp-file-line-regexp eol t)
  765.      (goto-char (match-beginning 0)) ; returns (point)
  766.        (if raise-error
  767.        (error "No file on this line")
  768.      (goto-char bol)))))
  769.  
  770. (efs-defun efs-dired-manual-move-to-end-of-filename dos:stcp
  771.   (&optional no-error bol eol)
  772.   ;; Assumes point is at the beginning of filename.
  773.   ;; So, it should be called only after (dired-move-to-filename t)
  774.   ;; On failure signals an error, or returns nil.
  775.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  776.  
  777. (efs-defun efs-dired-fixup-listing dos:stcp
  778.   (file path &optional switches wildcard)
  779.   ;; The Super-TCP server outputs lines in seemingly random order.
  780.   ;; This isn't as good as sorting switches, but at least it's not random.
  781.   (sort-fields 1 (point-min) (point-max)))
  782.  
  783. ;;;;----------------------------------------------------------
  784. ;;;; Winsock DOS FTP server (Alun's FTP server)
  785. ;;;;----------------------------------------------------------
  786.  
  787. (efs-defun efs-parse-listing dos:winsock
  788.   (host user dir path &optional switches)
  789.   ;; Parse the current buffer which is assumed to be a DOS Winsock listing.
  790.   ;; HOST = remote host name
  791.   ;; USER = remote user name
  792.   ;; DIR = directory as a full remote path
  793.   ;; PATH = directory in full efs-path syntax
  794.   
  795.   (goto-char (point-min))
  796.   (efs-save-match-data
  797.     (if (re-search-forward efs-dos:winsock-date-and-size-regexp nil t)
  798.     (let ((tbl (efs-make-hashtable))
  799.           size dirp)
  800.       (while
  801.           (progn
  802.         (setq size (string-to-int (buffer-substring (match-beginning 1)
  803.                                 (match-end 1)))
  804.               dirp (save-excursion
  805.                  (beginning-of-line)
  806.                  (skip-chars-forward " ")
  807.                  (char-equal (following-char) ?d)))
  808.         (efs-put-hash-entry
  809.          (buffer-substring (point) (progn (end-of-line) (point)))
  810.          (list dirp size) tbl)
  811.         (re-search-forward efs-dos:winsock-date-and-size-regexp nil t)))
  812.       (efs-put-hash-entry "." '(t) tbl)
  813.       (efs-put-hash-entry ".." '(t) tbl)
  814.       tbl))))
  815.  
  816. (defconst efs-dired-dos:winsock-re-exe "\\.exe$")
  817.  
  818. (or (assq 'dos:winsock efs-dired-re-exe-alist)
  819.     (setq efs-dired-re-exe-alist
  820.       (cons (cons 'dos:winsock  efs-dired-dos:winsock-re-exe)
  821.          efs-dired-re-exe-alist)))
  822.  
  823. (defconst efs-dired-dos:winsock-re-dir "^. +d")
  824.  
  825. (or (assq 'dos:winsock efs-dired-re-dir-alist)
  826.     (setq efs-dired-re-dir-alist
  827.        (cons (cons 'dos:winsock efs-dired-dos:winsock-re-dir)
  828.          efs-dired-re-dir-alist)))
  829.  
  830. (efs-defun efs-dired-insert-headerline dos:winsock (dir)
  831.   (efs-dired-pc-insert-headerline dir))
  832.  
  833. (efs-defun efs-dired-manual-move-to-filename dos:winsock
  834.   (&optional raise-error bol eol)
  835.   ;; In dired, move to the first char of filename on this line.
  836.   ;; Returns (point) or nil if raise-error is nil, and there is no
  837.   ;; no filename on this line.
  838.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  839.   (let (case-fold-search)
  840.     (if bol
  841.     (goto-char bol)
  842.       (skip-chars-backward "^\n\r")
  843.       (setq bol (point)))
  844.     (if (re-search-forward efs-dos:winsock-date-and-size-regexp eol t)
  845.     (point)
  846.       (if raise-error
  847.       (error "No file on this line")
  848.     (goto-char bol)))))
  849.  
  850. (efs-defun efs-dired-manual-move-to-end-of-filename dos:winsock
  851.   (&optional no-error bol eol)
  852.   ;; Assumes point is at the beginning of filename.
  853.   ;; So, it should be called only after (dired-move-to-filename t)
  854.   ;; On failure signals an error, or returns nil.
  855.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  856.  
  857. (efs-defun efs-dired-fixup-listing dos:winsock
  858.   (file path &optional switches wildcard)
  859.   ;; The Winsock server outputs lines in seemingly random order.
  860.   ;; This isn't as good as sorting switches, but at least it's not random.
  861.   (sort-fields 9 (point-min) (point-max)))
  862.  
  863. ;;;;-----------------------------------------------------------
  864. ;;;;  OS/2 Support
  865. ;;;;-----------------------------------------------------------
  866.  
  867. ;;; OS/2 has two types of file systems, FAT and HPFS. In the FAT file system
  868. ;;; filenames are restricted to the traditional DOS 8 + 3 syntax. In the
  869. ;;; HPFS file system, filenames can have arbitrarily many extensions (.'s).
  870. ;;; As well, file lines for "." and ".." are listed for HPFS.
  871. ;;; For the FAT FS, "." and ".." lines are only listed for sudirs, it seems.
  872. ;;; Go figure...
  873.  
  874. (defconst efs-os2-file-line-regexp
  875.   (concat
  876.    " +\\([0-9]+\\) +\\([^ ]+\\)? +[01][0-9]-[0-3][0-9]-[0-9][0-9] +"
  877.    "[0-2][0-9]:[0-6][0-9] +"))
  878.  
  879. (efs-defun efs-fix-path os2 (path &optional reverse)
  880.   (efs-fix-pc-path path reverse))
  881.  
  882. (efs-defun efs-fix-dir-path os2 (dir-path)
  883.   ;; Convert path from UNIX-ish to DOS for a DIRectory listing.
  884.   (cond ((string-match "^/\\(.:\\)?$" dir-path)
  885.      (error "Can't list DOS or OS/2 disks"))
  886.     ;; Neither DOS nor OS/2 allows us to end the name of a directory
  887.     ;; with an "\".
  888.     ;; Can't just hack it off, because if the dir is C:, we'll get the
  889.     ;; default dir.
  890.     ;; Don't apend the filename wildcard to distinguish
  891.     ;; plain files from directories, because OS/2 and DOS may
  892.     ;; not agree on what the wildcard is. Also, can't then tell
  893.     ;; the difference between plain files and empty directories.
  894.     ((string-match "/$" dir-path)
  895.      (concat (efs-fix-pc-path dir-path) "."))
  896.     (t (efs-fix-pc-path dir-path))))
  897.  
  898. (defconst efs-os2-dot-line-regexp
  899.   (concat efs-os2-file-line-regexp "\\.\n"))
  900.  
  901. (efs-defun efs-parse-listing os2
  902.   (host user dir path &optional switches)
  903.   ;; Parse the current buffer which is assumed to be an OS/2 listing.
  904.   ;; To make sure that it is really a directory listing and not a bogus
  905.   ;; listing of a single file, make sure that there is an entry for ".".
  906.   ;; HOST = remote host name
  907.   ;; USER = remote user name
  908.   ;; DIR = directory as a full remote path
  909.   ;; PATH = directory in full efs-path syntax
  910.   (efs-save-match-data
  911.     (if (or
  912.      (string-match "^/.:/$" dir) ; FAT proofing
  913.      (progn
  914.        (goto-char (point-min))
  915.        (re-search-forward efs-os2-dot-line-regexp nil t)))
  916.     (let ((tbl (efs-make-hashtable)))
  917.       (goto-char (point-min))
  918.       (efs-put-hash-entry "." '(t) tbl)
  919.       (efs-put-hash-entry ".." '(t) tbl)
  920.       (while (looking-at efs-os2-file-line-regexp)
  921.         (end-of-line)
  922.         (efs-put-hash-entry
  923.          (buffer-substring (match-end 0) (point))
  924.          (list (and
  925.             (match-beginning 2)
  926.             (string-equal "DIR"
  927.                   (buffer-substring (match-beginning 2)
  928.                             (match-end 2))))
  929.            (string-to-int (buffer-substring (match-beginning 1)
  930.                             (match-end 1))))
  931.          tbl)
  932.         (forward-line 1))
  933.       tbl))))
  934.  
  935. ;;; Tree Dired
  936.  
  937. (defconst efs-dired-os2-re-exe
  938.   "^[^\n]+\\.EXEC?$")
  939.  
  940. (or (assq 'os2 efs-dired-re-exe-alist)
  941.     (setq efs-dired-re-exe-alist
  942.       (cons (cons 'os2  efs-dired-os2-re-exe)
  943.         efs-dired-re-exe-alist)))
  944.  
  945. (defconst efs-dired-os2-re-dir
  946.   "^ +[0-9]+ +DIR ")
  947.  
  948. (or (assq 'os2 efs-dired-re-dir-alist)
  949.     (setq efs-dired-re-dir-alist
  950.       (cons (cons 'os2  efs-dired-os2-re-dir)
  951.         efs-dired-re-dir-alist)))
  952.  
  953. (efs-defun efs-dired-manual-move-to-filename os2
  954.   (&optional raise-error bol eol)
  955.   ;; In dired, move to the first char of filename on this line.
  956.   ;; Returns (point) or nil if raise-error is nil, and there is no
  957.   ;; no filename on this line.
  958.   ;; This version is for OS/2
  959.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  960.   (let (case-fold-search)
  961.     (if bol
  962.     (goto-char bol)
  963.       (skip-chars-backward "^\n\r")
  964.       (setq bol (point)))
  965.     (if (and
  966.      (> (- eol bol) 24)
  967.      (progn
  968.        (forward-char 2)
  969.        (looking-at efs-os2-file-line-regexp)))
  970.     (goto-char (match-end 0))
  971.       (and raise-error (error "No file on this line")))))
  972.  
  973. (efs-defun efs-dired-manual-move-to-end-of-filename os2
  974.   (&optional no-error bol eol)
  975.   (efs-dired-pc-move-to-end-of-filename no-error bol eol))
  976.  
  977. (efs-defun efs-dired-insert-headerline os2 (dir)
  978.   (efs-dired-pc-insert-headerline dir))
  979.  
  980. ;; end of efs-pc.el
  981.